home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / shells / scsh-0.4 / scsh-0 / scsh-0.4.2 / debug-packages.scm < prev    next >
Text File  |  1995-10-13  |  3KB  |  135 lines
  1. ; Copyright (c) 1993, 1994 Richard Kelsey and Jonathan Rees.  See file COPYING.
  2.  
  3.  
  4. ; Handy things for debugging the run-time system, byte code compiler,
  5. ; and linker.
  6.  
  7.  
  8. ; Alternative command processor.  Handy for debugging the bigger one.
  9.  
  10. (define (make-mini-command scheme)
  11.   (define-structure mini-command (export command-processor)
  12.     (open scheme
  13.       signals conditions handle
  14.       display-conditions)
  15.     (files (debug mini-command)))
  16.   mini-command)
  17.  
  18. ; Miniature EVAL, for debugging runtime system sans package system.
  19.  
  20. (define-structures ((mini-eval evaluation-interface)
  21.             (mini-environments
  22.              (export interaction-environment
  23.                  scheme-report-environment
  24.                  set-interaction-environment!
  25.                  set-scheme-report-environment!)))
  26.   (open scheme-level-2
  27.     signals)        ;error
  28.   (files (debug mini-eval)))
  29.  
  30. (define (make-scheme environments evaluation) ;cf. initial-packages.scm
  31.   (define-structure scheme scheme-interface
  32.     (open scheme-level-2
  33.       environments
  34.       evaluation))
  35.   scheme)
  36.  
  37. ; Stand-alone system that doesn't contain a byte-code compiler.
  38. ; This is useful for various testing purposes.
  39.  
  40. (define mini-scheme (make-scheme mini-environments mini-eval))
  41.  
  42. (define mini-command (make-mini-command mini-scheme))
  43.  
  44. (define-structure little-system (export start)
  45.   (open scheme-level-1
  46.     mini-command
  47.     scheme-level-2-internal)
  48.   (begin (define start
  49.        (usual-resumer
  50.         (lambda (args) (command-processor #f args))))))
  51.  
  52. (define (link-little-system)
  53.   (link-simple-system '(debug little)
  54.               'start
  55.               little-system))
  56.  
  57.  
  58.  
  59. ; --------------------
  60. ; Hack: smallest possible reified system.
  61.  
  62. (define-structures ((mini-for-reification for-reification-interface)
  63.             (mini-packages (export make-simple-package)))
  64.   (open scheme-level-2
  65.     ;; tables
  66.     features        ;contents
  67.     locations
  68.     signals)        ;error
  69.   (files (debug mini-package)))
  70.  
  71. (define-structure mini-system (export start)
  72.   (open mini-scheme
  73.     mini-command
  74.     mini-for-reification
  75.     mini-packages
  76.     mini-environments        ;set-interaction-environment!
  77.     scheme-level-2-internal        ;usual-resumer
  78.     conditions handle        ;error? with-handler
  79.     signals)            ;error
  80.   (files (debug mini-start)))
  81.  
  82. (define (link-mini-system)
  83.   (link-reified-system (list (cons 'scheme mini-scheme)
  84.                  (cons 'write-images write-images)
  85.                  (cons 'primitives primitives) ;just for fun
  86.                  (cons 'scheme-level-2-internal
  87.                    scheme-level-2-internal)
  88.                  (cons 'command mini-command))
  89.                '(debug mini)
  90.                'start
  91.                mini-system mini-for-reification))
  92.  
  93.  
  94.  
  95. ; --------------------
  96. ; S-expression interpreter
  97.  
  98. (define-structure run evaluation-interface
  99.   (open scheme-level-2 syntactic packages scan meta-types
  100.     environments
  101.     signals
  102.     locations
  103.     features   ;force-output
  104.     tables
  105.     fluids)
  106.   (files (debug run)))
  107.  
  108.  
  109. ; Hack: an interpreter-based system.
  110.  
  111. (define (link-medium-system)        ;cf. initial.scm
  112.  
  113.   (def medium-scheme (make-scheme environments run))
  114.  
  115.   (let ()
  116.  
  117.     (def command (make-mini-command medium-scheme))
  118.  
  119.     (let ()
  120.  
  121.       (def medium-system
  122.     ;; Cf. initial-packages.scm
  123.     (make-initial-system medium-scheme command))
  124.  
  125.       (let ((structs (list (cons 'scheme medium-scheme)
  126.                (cons 'primitives primitives) ;just for fun
  127.                (cons 'scheme-level-2-internal
  128.                  scheme-level-2-internal)
  129.                (cons 'command command))))
  130.  
  131.     (link-reified-system structs
  132.                  '(debug medium)
  133.                  `(start ',(map car structs))
  134.                  medium-system for-reification)))))
  135.